home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt3sp2.arc / PIBFMANI.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-09-07  |  33.2 KB  |  842 lines
  1. (*----------------------------------------------------------------------*)
  2. (*        PibFileManipulation --- File Manipulation for Turbo           *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. OVERLAY PROCEDURE PibFileManipulation;
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  PibFileManipulation                                  *)
  10. (*                                                                      *)
  11. (*     Purpose:    Central control routine for file manipulation        *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        PibFileManipulation;                                          *)
  16. (*                                                                      *)
  17. (*     Calls:                                                           *)
  18. (*                                                                      *)
  19. (*     Remarks:                                                         *)
  20. (*                                                                      *)
  21. (*        This routine exists to centralize file manipulation so that   *)
  22. (*        the Turbo Pascal overlay scheme will work.                    *)
  23. (*                                                                      *)
  24. (*----------------------------------------------------------------------*)
  25.  
  26. VAR
  27.    File_Menu     : Menu_Type;
  28.    I             : INTEGER;
  29.  
  30. (*----------------------------------------------------------------------*)
  31. (*           Get_File_Size --- Get size in bytes for a file             *)
  32. (*----------------------------------------------------------------------*)
  33.  
  34. FUNCTION Get_File_Size( Fname: AnyStr; VAR OpenOK : BOOLEAN ): REAL;
  35.  
  36. (*----------------------------------------------------------------------*)
  37. (*                                                                      *)
  38. (*     Procedure:  Get_File_Size                                        *)
  39. (*                                                                      *)
  40. (*     Purpose:    Get size in bytes for a file                         *)
  41. (*                                                                      *)
  42. (*     Calling Sequence:                                                *)
  43. (*                                                                      *)
  44. (*        Fsize := Get_File_Size( Fname      : AnyStr;                  *)
  45. (*                                VAR OpenOK : BOOLEAN ) : Real;        *)
  46. (*                                                                      *)
  47. (*           Fname  --- name of file to find size of                    *)
  48. (*           OpenOK --- set TRUE if file opened successfully            *)
  49. (*           Fsize  --- file size in bytes                              *)
  50. (*                                                                      *)
  51. (*     Calls:                                                           *)
  52. (*                                                                      *)
  53. (*        RESET                                                         *)
  54. (*        Int24Result                                                   *)
  55. (*        ASSIGN                                                        *)
  56. (*        LongFileSize                                                  *)
  57. (*        Close                                                         *)
  58. (*                                                                      *)
  59. (*     Remarks:                                                         *)
  60. (*                                                                      *)
  61. (*        The file must not already be opened before calling this       *)
  62. (*        routine.                                                      *)
  63. (*                                                                      *)
  64. (*----------------------------------------------------------------------*)
  65.  
  66. VAR
  67.    F : FILE OF BYTE;
  68.  
  69. BEGIN (* Get_File_Size *)
  70.  
  71.    Get_File_Size := 0.0;
  72.  
  73.    ASSIGN( F , Fname );
  74.    (*$I- *)
  75.    RESET ( F );
  76.    (*$I+ *)
  77.  
  78.    IF Int24Result = 0 THEN
  79.       BEGIN
  80.          Get_File_Size := LongFileSize( F );
  81.          CLOSE( F );
  82.          OpenOK := TRUE;
  83.       END
  84.    ELSE
  85.       OpenOK := FALSE;
  86.  
  87. END   (* Get_File_Size *);
  88.  
  89. (*----------------------------------------------------------------------*)
  90. (*           View_A_File --- List ascii file                            *)
  91. (*----------------------------------------------------------------------*)
  92.  
  93. PROCEDURE View_A_File;
  94.  
  95. (*----------------------------------------------------------------------*)
  96. (*                                                                      *)
  97. (*     Procedure:  View_A_File                                          *)
  98. (*                                                                      *)
  99. (*     Purpose:    Lists selected ascii file                            *)
  100. (*                                                                      *)
  101. (*     Calling Sequence:                                                *)
  102. (*                                                                      *)
  103. (*        View_A_File;                                                  *)
  104. (*                                                                      *)
  105. (*     Calls:   View_Prompt                                             *)
  106. (*              Save_Screen                                             *)
  107. (*              Restore_Screen                                          *)
  108. (*              Draw_Menu_Frame                                         *)
  109. (*              Reset_Global_Colors                                     *)
  110. (*                                                                      *)
  111. (*     Remarks:                                                         *)
  112. (*                                                                      *)
  113. (*        This routine will list non-ascii files, but they will be      *)
  114. (*        meaningless.                                                  *)
  115. (*                                                                      *)
  116. (*----------------------------------------------------------------------*)
  117.  
  118. VAR
  119.    View_File_Name : STRING[15];
  120.    ViewFile       : Text;
  121.    View_File_Open : BOOLEAN;
  122.    View_File_Size : Real;
  123.  
  124. BEGIN (* View_A_File *)
  125.                                    (*  Draw view menu *)
  126.  
  127.    Save_Screen( Saved_Screen );
  128.    Draw_Menu_Frame( 5, 4, 75, 25, Menu_Frame_Color,
  129.                     Menu_Text_Color, 'View A File' );
  130.  
  131.                                    (* Get name of file to list *)
  132.    WRITELN;
  133.    WRITE('Enter name of file to list: ');
  134.    READLN( View_File_Name );
  135.  
  136.    View_File_Open := FALSE;
  137.  
  138.                                    (* Ensure file exists ... *)
  139.    IF LENGTH( View_File_Name ) > 0 THEN
  140.       BEGIN  (* View_File_Name > 0 *)
  141.  
  142.          View_File_Size := Get_File_Size( View_File_Name , View_File_Open );
  143.  
  144.  
  145.          IF ( NOT View_File_Open ) THEN
  146.             BEGIN (* Int24Result <> 0 *)
  147.                TextColor( Menu_Text_Color + Blink );
  148.                WRITELN('>>> Can''t open file ',View_File_Name,' for viewing.');
  149.                DELAY( Two_Second_Delay );
  150.                TextColor( Menu_Text_Color );
  151.             END   (* Int24Result <> 0 *)
  152.  
  153.                                    (* ... and file is not empty *)
  154.  
  155.         ELSE IF ( View_File_Size <= 0  ) THEN
  156.             BEGIN  (* File is empty *)
  157.                TextColor( Menu_Text_Color + Blink );
  158.                WRITELN('>>> File ',View_File_Name,' is empty.');
  159.                DELAY( Two_Second_Delay );
  160.                TextColor( Menu_Text_Color );
  161.             END    (* File is empty *)
  162.  
  163.         ELSE                       (* Write header line         *)
  164.             BEGIN  (* List the File *)
  165.  
  166.                ASSIGN( ViewFile, View_File_Name );
  167.                RESET( ViewFile );
  168.  
  169.                Clear_Window;
  170.  
  171.                RvsVideoOn( Menu_Text_Color , BackGround_Color );
  172.  
  173.                WRITELN('LISTING OF FILE: ',View_File_Name,
  174.                        '        SIZE: ', View_File_Size:8:0, ' BYTES.');
  175.  
  176.                RvsVideoOff( Menu_Text_Color , BackGround_Color );
  177.  
  178.                                    (* RESET window so header doesn't vanish *)
  179.                Window( 7, 6, 74, 24 );
  180.                GoToXY( 1 , WhereY );
  181.  
  182.                                    (* List the file             *)
  183.  
  184.                View_Count := 0;
  185.                View_Done  := FALSE;
  186.  
  187.                REPEAT
  188.                                    (* Read and write line from file *)
  189.                   READLN ( ViewFile , View_Line );
  190.                   IF Length( View_Line ) > 65 THEN View_Line[0] := CHR( 65 );
  191.                   WRITELN( View_Line );
  192.  
  193.                                    (* Increment count of lines displayed *)
  194.                   View_Count := View_Count + 1;
  195.  
  196.                                    (* Prompt if end of screen *)
  197.                   IF View_Count > 17 THEN
  198.                      View_Prompt( View_Done , View_Count );
  199.  
  200.                UNTIL EOF( ViewFile ) OR View_Done;
  201.  
  202.                RvsVideoOn( Menu_Text_Color , BackGround_Color );
  203.                WRITE('Viewing of file complete. ',
  204.                      'Hit any key to continue.');
  205.                RvsVideoOff( Menu_Text_Color , BackGround_Color );
  206.                WHILE ( Not KeyPressed ) DO ;
  207.                READ( Kbd , View_Char[1] );
  208.  
  209.             END  (* List the file *);
  210.  
  211.       END  (* View_File_Name > 0 *);
  212.  
  213.    IF View_File_Open THEN Close( ViewFile );
  214.  
  215.    Restore_Screen( Saved_Screen );
  216.    Reset_Global_Colors;
  217.  
  218. END   (* View_A_File *);
  219.  
  220. (*----------------------------------------------------------------------*)
  221. (*      View_Directory --- List files in current directory              *)
  222. (*----------------------------------------------------------------------*)
  223.  
  224. PROCEDURE View_Directory;
  225.  
  226. (*----------------------------------------------------------------------*)
  227. (*                                                                      *)
  228. (*     Procedure:  View_Directory                                       *)
  229. (*                                                                      *)
  230. (*     Purpose:    Lists files in current MSDOS directory               *)
  231. (*                                                                      *)
  232. (*     Calling Sequence:                                                *)
  233. (*                                                                      *)
  234. (*        View_Directory;                                               *)
  235. (*                                                                      *)
  236. (*     Calls:   View_Prompt                                             *)
  237. (*              Save_Screen                                             *)
  238. (*              Restore_Screen                                          *)
  239. (*              Draw_Menu_Frame                                         *)
  240. (*              Reset_Global_Colors                                     *)
  241. (*              Dir_Get_Default_Drive                                   *)
  242. (*              Dir_Get_Current_Path                                    *)
  243. (*              Dir_Find_First_File                                     *)
  244. (*              Dir_Find_Next_File                                      *)
  245. (*              Dir_Convert_Time                                        *)
  246. (*              Dir_Convert_Date                                        *)
  247. (*                                                                      *)
  248. (*----------------------------------------------------------------------*)
  249.  
  250. VAR
  251.    View_Directory_Name : AnyStr;
  252.    Drive_Ch            : CHAR;
  253.    Iok                 : INTEGER;
  254.    File_Entry          : Directory_Record;
  255.    S_File_Name         : STRING[14];
  256.    S_File_Time         : STRING[8];
  257.    S_File_Date         : STRING[8];
  258.    S_File_Size         : Real;
  259.    S_File_Xmodem_Time  : STRING[8];
  260.    Fs1                 : Real;
  261.    Fs2                 : Real;
  262.    I                   : INTEGER;
  263.  
  264. BEGIN (* View_Directory *)
  265.                                    (*  Draw view menu *)
  266.  
  267.    Save_Screen( Saved_Screen );
  268.    Draw_Menu_Frame( 5, 4, 75, 25, Menu_Frame_Color,
  269.                     Menu_Text_Color, 'View Current Directory' );
  270.  
  271.    RvsVideoOn( Menu_Text_Color , BackGround_Color );
  272.  
  273.    Drive_Ch := Dir_Get_Default_Drive;
  274.  
  275.    Iok := Dir_Get_Current_Path( Drive_Ch , View_Directory_Name );
  276.  
  277.    WRITELN('LISTING OF DIRECTORY: ',Drive_Ch + ':\' + View_Directory_Name );
  278.    WRITELN('      File Name     Size     Date     Time  Xfer Time');
  279.  
  280.    RvsVideoOff( Menu_Text_Color , BackGround_Color );
  281.  
  282.                                    (* RESET window so header doesn't vanish *)
  283.    Window( 7, 7, 74, 24 );
  284.    GoToXY( 1 , WhereY );
  285.  
  286.                                    (* List the directory contents   *)
  287.  
  288.    View_Count := 0;
  289.    View_Done  := ( Dir_Find_First_File( '*.*', File_Entry ) <> 0 );
  290.  
  291.    WHILE( NOT View_Done ) DO
  292.       BEGIN
  293.                                    (* Display Next Directory Entry       *)
  294.          S_File_Name := '';
  295.          I           := 1;
  296.                                    (* Pick up file name *)
  297.  
  298.          WHILE( ( I <= 14 ) AND ( File_Entry.File_Name[I] <> CHR(0) ) ) DO
  299.             BEGIN
  300.                S_File_Name := S_File_Name + File_Entry.File_Name[I];
  301.                I           := I + 1;
  302.             END;
  303.                                    (* Pick up creation date and time *)
  304.  
  305.          Dir_Convert_Time( File_Entry.File_Time , S_File_Time );
  306.          Dir_Convert_Date( File_Entry.File_Date , S_File_Date );
  307.  
  308.                                    (* Pick up file size *)
  309.  
  310.          Fs1 := File_Entry.File_Size[1];
  311.          Fs2 := File_Entry.File_Size[2];
  312.  
  313.          IF Fs1 < 0 THEN Fs1 := Fs1 + 65536.0;
  314.          IF Fs2 < 0 THEN Fs2 := Fs2 + 65536.0;
  315.  
  316.          S_File_Size := Fs2 * 65536.0 + Fs1;
  317.  
  318.                                    (* Pick up transfer time *)
  319.  
  320.          S_File_Xmodem_Time := TimeString( ROUND( ( S_File_Size / 128.0 ) + 0.49 ) *
  321.                                          ( Trans_Time_Val / Baud_Rate ) );
  322.  
  323.                                    (* Display entry *)
  324.  
  325.          WRITELN( S_File_Name:14, ' ', S_File_Size:8:0, ' ', S_File_Date, ' ',
  326.                   S_File_Time,'   ',S_File_Xmodem_Time );
  327.  
  328.                                    (* Increment count of lines displayed *)
  329.  
  330.          View_Count := View_Count + 1;
  331.  
  332.                                    (* Prompt if end of screen *)
  333.          IF View_Count > 16 THEN
  334.             View_Prompt( View_Done , View_Count );
  335.  
  336.          View_Done := View_Done OR ( Dir_Find_Next_File( File_Entry ) <> 0 );
  337.  
  338.    END;
  339.                                    (* Issue final end-of-directory prompt *)
  340.  
  341.    RvsVideoOn( Menu_Text_Color , BackGround_Color );
  342.  
  343.    WRITE('Viewing of directory complete. ',
  344.          'Hit any key to continue.');
  345.  
  346.    RvsVideoOff( Menu_Text_Color , BackGround_Color );
  347.  
  348.    WHILE ( NOT KeyPressed ) DO ;
  349.  
  350.    READ( Kbd , View_Char );
  351.                                    (* Restore previous screen *)
  352.  
  353.    Restore_Screen( Saved_Screen );
  354.    Reset_Global_Colors;
  355.  
  356. END   (* View_Directory *);
  357.  
  358. (*----------------------------------------------------------------------*)
  359. (*      Log_Drive_Change --- Change current logged drive                *)
  360. (*----------------------------------------------------------------------*)
  361.  
  362. PROCEDURE Log_Drive_Change;
  363.  
  364. (*----------------------------------------------------------------------*)
  365. (*                                                                      *)
  366. (*     Procedure:  Log_Drive_Change                                     *)
  367. (*                                                                      *)
  368. (*     Purpose:    Change current logged drive                          *)
  369. (*                                                                      *)
  370. (*     Calling Sequence:                                                *)
  371. (*                                                                      *)
  372. (*        Log_Drive_Change                                              *)
  373. (*                                                                      *)
  374. (*     Calls:   Dir_Get_Default_Drive                                   *)
  375. (*              Dir_Set_Default_Drive                                   *)
  376. (*              Save_Screen                                             *)
  377. (*              Restore_Screen                                          *)
  378. (*              Draw_Menu_Frame                                         *)
  379. (*              Reset_Global_Colors                                     *)
  380. (*                                                                      *)
  381. (*                                                                      *)
  382. (*----------------------------------------------------------------------*)
  383.  
  384. VAR
  385.    Drive_Ch    : STRING[1];
  386.    Drive_No    : INTEGER;
  387.    Drive_Count : INTEGER;
  388.  
  389. BEGIN (* Log_Drive_Change *);
  390.  
  391.                                    (*  Draw log change menu *)
  392.  
  393.    Save_Screen( Saved_Screen );
  394.    Draw_Menu_Frame( 5, 10, 55, 15, Menu_Frame_Color,
  395.                     Menu_Text_Color, 'Change Current Logged Drive' );
  396.  
  397.    GoToXY( 1 , 1 );
  398.    Drive_Ch[1] := Dir_Get_Default_Drive;
  399.  
  400.    WRITELN('Current logged drive is ',Drive_Ch[1] );
  401.  
  402.    GoToXY( 1 , 2 );
  403.  
  404.    WRITE('Enter letter for new logged drive: ');
  405.  
  406.    READ( Kbd , Drive_Ch );
  407.    WRITE( Drive_Ch );
  408.  
  409.    IF LENGTH( Drive_Ch ) = 0 THEN
  410.       BEGIN
  411.          WRITELN;
  412.          WRITELN('*** Logged drive remains unchanged.')
  413.       END
  414.    ELSE
  415.       BEGIN
  416.                                 (* Figure no. of drives in system *)
  417.          Drive_Count := Dir_Count_Drives;
  418.  
  419.                                 (* Drive no. for entered letter   *)
  420.          Drive_No    := ORD( UpCASE( Drive_Ch ) ) - ORD( 'A' );
  421.  
  422.                                 (* Check if drive legitimate      *)
  423.  
  424.          IF ( Drive_No < 0 ) OR ( Drive_No > Drive_Count ) THEN
  425.             WRITELN('*** Invalid drive, logged drive unchanged.')
  426.          ELSE
  427.             BEGIN
  428.                                 (* Change default drive *)
  429.                Dir_Set_Default_Drive( Drive_Ch );
  430.  
  431.                WRITELN;
  432.                WRITELN('*** Logged drive changed to ',Drive_Ch );
  433.  
  434.             END;
  435.  
  436.       END;
  437.  
  438.    DELAY( Two_Second_Delay );
  439.  
  440.                                    (* Restore previous screen *)
  441.    Restore_Screen( Saved_Screen );
  442.    Reset_Global_Colors;
  443.  
  444. END   (* Log_Drive_Change *);
  445.  
  446. (*----------------------------------------------------------------------*)
  447. (*       Change_Subdirectory --- Change current disk subdirectory       *)
  448. (*----------------------------------------------------------------------*)
  449.  
  450. PROCEDURE Change_Subdirectory;
  451.  
  452. (*----------------------------------------------------------------------*)
  453. (*                                                                      *)
  454. (*     Procedure:  Change_Subdirectory                                  *)
  455. (*                                                                      *)
  456. (*     Purpose:    Change current subdirectory                          *)
  457. (*                                                                      *)
  458. (*     Calling Sequence:                                                *)
  459. (*                                                                      *)
  460. (*        Change_Subdirectory;                                          *)
  461. (*                                                                      *)
  462. (*     Calls:   Dir_Get_Default_Drive                                   *)
  463. (*              Dir_Set_Current_Path                                    *)
  464. (*              Dir_Get_Current_Path                                    *)
  465. (*              Save_Screen                                             *)
  466. (*              Restore_Screen                                          *)
  467. (*              Draw_Menu_Frame                                         *)
  468. (*              Reset_Global_Colors                                     *)
  469. (*                                                                      *)
  470. (*                                                                      *)
  471. (*----------------------------------------------------------------------*)
  472.  
  473. VAR
  474.    Path_Name : AnyStr;
  475.    Iok       : INTEGER;
  476.    Drive_Ch  : CHAR;
  477.  
  478. BEGIN (* Change_Subdirectory *)
  479.                                    (*  Draw directory change menu *)
  480.  
  481.    Save_Screen( Saved_Screen );
  482.    Draw_Menu_Frame( 5, 10, 60, 15, Menu_Frame_Color,
  483.                     Menu_Text_Color, 'Change Current Directory' );
  484.  
  485.    GoToXY( 1 , 1 );
  486.  
  487.    Drive_Ch := Dir_Get_Default_Drive;
  488.  
  489.    Iok := Dir_Get_Current_Path( Drive_Ch , Path_Name );
  490.  
  491.    WRITELN('Current directory is ', Drive_Ch + ':\' + Path_Name );
  492.  
  493.    WRITE('Enter name of new directory path: ');
  494.  
  495.    READ( Path_Name );
  496.    WRITELN;
  497.  
  498.    IF LENGTH( Path_Name ) = 0 THEN
  499.       WRITELN('*** Current directory remains unchanged.')
  500.    ELSE
  501.       BEGIN
  502.  
  503.          IF Dir_Set_Current_Path( Path_Name ) = 0 THEN
  504.             WRITELN('*** Current directory changed to ',
  505.                     Drive_Ch + ':' + Path_Name )
  506.          ELSE
  507.             WRITELN('*** Error found, directory not changed');
  508.       END;
  509.  
  510.    DELAY( Two_Second_Delay );
  511.  
  512.                                    (* Restore previous screen *)
  513.    Restore_Screen( Saved_Screen );
  514.    Reset_Global_Colors;
  515.  
  516. END   (* Change_Subdirectory *);
  517.  
  518. (*----------------------------------------------------------------------*)
  519. (*               Delete_A_File --- Delete a file                        *)
  520. (*----------------------------------------------------------------------*)
  521.  
  522. PROCEDURE Delete_A_File;
  523.  
  524. (*----------------------------------------------------------------------*)
  525. (*                                                                      *)
  526. (*     Procedure:  Delete_A_File                                        *)
  527. (*                                                                      *)
  528. (*     Purpose:    Delete file in current subdirectory                  *)
  529. (*                                                                      *)
  530. (*     Calling Sequence:                                                *)
  531. (*                                                                      *)
  532. (*        Delete_A_File;                                                *)
  533. (*                                                                      *)
  534. (*     Calls:   Dir_Delete_File                                         *)
  535. (*              Save_Screen                                             *)
  536. (*              Restore_Screen                                          *)
  537. (*              Draw_Menu_Frame                                         *)
  538. (*              Reset_Global_Colors                                     *)
  539. (*                                                                      *)
  540. (*----------------------------------------------------------------------*)
  541.  
  542. VAR
  543.    File_Name : AnyStr;
  544.  
  545. BEGIN (* Delete_A_File *)
  546.                                    (*  Draw delete file menu *)
  547.  
  548.    Save_Screen( Saved_Screen );
  549.    Draw_Menu_Frame( 5, 10, 60, 14, Menu_Frame_Color,
  550.                     Menu_Text_Color + Blink, 'Delete A File -- Be Careful!' );
  551.  
  552.    TextColor( Menu_Text_Color );
  553.  
  554.    GoToXY( 1 , 1 );
  555.  
  556.    WRITE('Enter name of file to delete: ');
  557.  
  558.    READ( File_Name );
  559.    WRITELN;
  560.  
  561.    IF LENGTH( File_Name ) = 0 THEN
  562.       WRITELN('*** No file to delete.')
  563.    ELSE
  564.       IF ( Dir_Delete_File( File_Name ) = 0 ) THEN
  565.          WRITELN('*** File deleted.')
  566.       ELSE
  567.          WRITELN('*** File not found to delete or read-only');
  568.  
  569.    DELAY( Two_Second_Delay );
  570.  
  571.                                    (* Restore previous screen *)
  572.    Restore_Screen( Saved_Screen );
  573.    Reset_Global_Colors;
  574.  
  575. END   (* Delete_A_File *);
  576.  
  577. (*----------------------------------------------------------------------*)
  578. (*        Find_Free_Space_On_Drive --- Find free space on a drive       *)
  579. (*----------------------------------------------------------------------*)
  580.  
  581. PROCEDURE Find_Free_Space_On_Drive;
  582.  
  583. (*----------------------------------------------------------------------*)
  584. (*                                                                      *)
  585. (*     Procedure:  Find_Free_Space_On_Drive                             *)
  586. (*                                                                      *)
  587. (*     Purpose:    Finds free space on a drive                          *)
  588. (*                                                                      *)
  589. (*     Calling Sequence:                                                *)
  590. (*                                                                      *)
  591. (*        Find_Free_Space_On_Drive;                                     *)
  592. (*                                                                      *)
  593. (*     Calls:   Dir_Get_Free_Space                                      *)
  594. (*              Save_Screen                                             *)
  595. (*              Restore_Screen                                          *)
  596. (*              Draw_Menu_Frame                                         *)
  597. (*              Reset_Global_Colors                                     *)
  598. (*                                                                      *)
  599. (*----------------------------------------------------------------------*)
  600.  
  601. VAR
  602.    Drive_Ch: CHAR;
  603.    Fspace:   REAL;
  604.  
  605. BEGIN (* Find_Free_Space_On_Drive *)
  606.  
  607.    Save_Screen( Saved_Screen );
  608.  
  609.    Draw_Menu_Frame( 10, 10, 61, 15, Menu_Frame_Color,
  610.                     Menu_Text_Color, 'Free space on drive' );
  611.  
  612.    REPEAT
  613.       GoToXY( 1 , 1 );
  614.       ClrEol;
  615.       Drive_CH := ' ';
  616.       WRITE('Which drive? ');
  617.       READ( Kbd , Drive_Ch );
  618.       WRITE( Drive_Ch );
  619.       Drive_Ch := UpCase( Drive_Ch );
  620.    UNTIL( Drive_Ch IN [' ','A'..'Z'] );
  621.  
  622.    IF Drive_Ch <> ' ' THEN
  623.       BEGIN
  624.          WRITELN;
  625.          FSpace := Dir_Get_Free_Space( Drive_Ch );
  626.          IF Fspace > 0.0 THEN
  627.             WRITELN('Free space on drive ',Drive_Ch,' is ',Fspace:8:0,' bytes')
  628.          ELSE
  629.             WRITELN('Can''t find free space for drive ',Drive_Ch);
  630.       END;
  631.  
  632.    WRITELN(' ');
  633.    WRITE  ('Hit any key to continue');
  634.  
  635.    READ( Kbd, Drive_Ch );
  636.  
  637.    IF ( Drive_Ch = CHR( ESC ) ) AND KeyPressed THEN
  638.       READ( Kbd, Drive_Ch );
  639.  
  640.    Restore_Screen( Saved_Screen );
  641.  
  642.    Reset_Global_Colors;
  643.  
  644. END   (* Find_Free_Space_On_Drive *);
  645.  
  646. (*----------------------------------------------------------------------*)
  647. (*                    Copy_A_File  --- Copy a file                      *)
  648. (*----------------------------------------------------------------------*)
  649.  
  650. PROCEDURE Copy_A_File;
  651.  
  652. (*----------------------------------------------------------------------*)
  653. (*                                                                      *)
  654. (*     Procedure:  Copy_A_File                                          *)
  655. (*                                                                      *)
  656. (*     Purpose:    Copies a file                                        *)
  657. (*                                                                      *)
  658. (*     Calling Sequence:                                                *)
  659. (*                                                                      *)
  660. (*        Copy_A_File;                                                  *)
  661. (*                                                                      *)
  662. (*     Calls:                                                           *)
  663. (*              Save_Screen                                             *)
  664. (*              Restore_Screen                                          *)
  665. (*              Draw_Menu_Frame                                         *)
  666. (*              Reset_Global_Colors                                     *)
  667. (*              Open_File_Handle                                        *)
  668. (*              Create_File_Handle                                      *)
  669. (*              Close_File_Handle                                       *)
  670. (*              Read_File_Handle                                        *)
  671. (*              Write_File_Handle                                       *)
  672. (*                                                                      *)
  673. (*----------------------------------------------------------------------*)
  674.  
  675. CONST
  676.    BufSize =  4096                 (* Buffer size       *);
  677.  
  678. VAR
  679.    F_Handle   : INTEGER            (* File to be copied *);
  680.    F_Size     : REAL               (* Size of file      *);
  681.    F_Open     : BOOLEAN            (* If F opened OK    *);
  682.    G_Handle   : INTEGER            (* File copied to    *);
  683.    G_Open     : BOOLEAN            (* If G opened OK    *);
  684.    G_Size     : REAL               (* Size of G         *);
  685.    F_Name     : AnyStr             (* Input file name   *);
  686.    G_Name     : AnyStr             (* Output file name  *);
  687.    Abort_Copy : BOOLEAN            (* TRUE to stop copy *);
  688.  
  689.    BytesRead  : INTEGER            (* # of bytes read   *);
  690.    BytesDone  : REAL               (* Total bytes read  *);
  691.  
  692.                                    (* Buffer area       *)
  693.    Buffer     : PACKED ARRAY[ 1 .. BufSize ] OF CHAR;
  694.  
  695.    Err        : INTEGER            (* I/O error flag    *);
  696.  
  697. LABEL  Abort_it;
  698.  
  699. BEGIN (* Copy_A_File *)
  700.                                    (* Announce file copy *)
  701.    Save_Screen( Saved_Screen );
  702.  
  703.    Draw_Menu_Frame( 5, 10, 75, 17, Menu_Frame_Color,
  704.                     Menu_Text_Color, 'Copy a file' );
  705.  
  706.    Abort_Copy := FALSE;
  707.                                    (* Get name of file to copy *)
  708.    REPEAT
  709.  
  710.       GoToXY( 1 , 1 );
  711.       WRITE(' Enter file to be copied:    ');
  712.       ClrEol;
  713.       READLN( F_Name );
  714.  
  715.       IF LENGTH( F_Name ) > 0 THEN
  716.          F_Size := Get_File_Size( F_Name, F_Open )
  717.       ELSE
  718.          Abort_Copy := TRUE;
  719.  
  720.    UNTIL ( F_Open OR Abort_Copy );
  721.  
  722.                                    (* Stop if no input file *)
  723.    IF Abort_Copy THEN GOTO Abort_It;
  724.  
  725.                                    (* Get name of file to copy to *)
  726.    REPEAT
  727.  
  728.       GoToXY( 1 , 2 );
  729.       WRITE(' Enter file to receive copy: ');
  730.       ClrEol;
  731.       READLN( G_Name );
  732.  
  733.       IF LENGTH( G_Name ) > 0 THEN
  734.          G_Size := Get_File_Size( G_Name, G_Open )
  735.       ELSE
  736.          Abort_Copy := TRUE;
  737.  
  738.       IF G_Open THEN
  739.          BEGIN
  740.             GoToXY( 1 , 3 );
  741.             G_Open := NOT YesNo(' File already exists, overwrite (Y or N)? ');
  742.          END;
  743.  
  744.    UNTIL ( ( NOT G_Open ) OR Abort_Copy );
  745.  
  746.                                    (* Open input file *)
  747.  
  748.    Err := Open_File_Handle( F_Name, Access_Read_Mode, F_Handle );
  749.  
  750.                                    (* Open output file *)
  751.  
  752.    Err := Create_File_Handle( G_Name , Access_Write_Mode, G_Handle );
  753.  
  754.                                    (* Report file size *)
  755.    GoToXY( 1 , 4 );
  756.    WRITE('Size of file ',F_Name,' in bytes is ',F_Size:8:0 );
  757.  
  758.    GoToXY( 1 , 5 );
  759.    WRITE('Bytes copied: ');
  760.  
  761.    BytesDone := 0.0;
  762.                                    (* Perform the copy *)
  763.    REPEAT
  764.  
  765.       BytesRead := BufSize;
  766.  
  767.       Err := Read_File_Handle( F_Handle, Buffer, BytesRead );
  768.  
  769.       IF BytesRead > 0 THEN
  770.          Err := Write_File_Handle( G_Handle, Buffer, BytesRead );
  771.  
  772.       BytesDone := BytesDone + BytesRead;
  773.  
  774.       GoToXY( 15 , 5 );
  775.       WRITE( BytesDone:8:0 );
  776.  
  777.    UNTIL ( BytesRead < BufSize );
  778.  
  779.                                    (* Close files  *)
  780.    Err := Close_File_Handle( F_Handle );
  781.    Err := Close_File_Handle( G_Handle );
  782.  
  783.    GoToXY( 1 , 6 );
  784.    WRITE('Copy complete.');
  785.    DELAY( Two_Second_Delay );
  786.  
  787. Abort_It:
  788.                                    (* Restore previous screen *)
  789.    Restore_Screen( Saved_Screen );
  790.  
  791.    Reset_Global_Colors;
  792.  
  793. END   (* Copy_A_File *);
  794.  
  795. (*----------------------------------------------------------------------*)
  796.  
  797. BEGIN (* PibFileManipulation *)
  798.  
  799.    File_Menu.Menu_Size    := 8;
  800.    File_Menu.Menu_Row     := 11;
  801.    File_Menu.Menu_Column  := 30;
  802.    File_Menu.Menu_Tcolor  := Menu_Text_Color;
  803.    File_Menu.Menu_Bcolor  := BackGround_Color;
  804.    File_Menu.Menu_Fcolor  := Menu_Frame_Color;
  805.    File_Menu.Menu_Width   := 0;
  806.    File_Menu.Menu_Height  := 0;
  807.  
  808.    File_Menu.Menu_Default := 8;
  809.  
  810.    FOR I := 1 TO 8 DO
  811.       WITH File_Menu.Menu_Entries[I] DO
  812.       BEGIN
  813.          Menu_Item_Row    := I;
  814.          Menu_Item_Column := 2;
  815.          CASE I Of
  816.             1:  Menu_Item_Text := 'A)ctive directory change';
  817.             2:  Menu_Item_Text := 'C)opy file';
  818.             3:  Menu_Item_Text := 'D)irectory display';
  819.             4:  Menu_Item_Text := 'E)rase file';
  820.             5:  Menu_Item_Text := 'F)ree space on drive';
  821.             6:  Menu_Item_Text := 'L)ogged drive change';
  822.             7:  Menu_Item_Text := 'V)iew a file';
  823.             8:  Menu_Item_Text := 'Q)uit';
  824.          END (* CASE *);
  825.       END;
  826.  
  827.    File_Menu.Menu_Title := 'Choose File Function: ';
  828.  
  829.    Menu_Display_Choices( File_Menu );
  830.  
  831.    CASE Menu_Get_Choice( File_Menu , Erase_Menu ) OF
  832.       1:  Change_Subdirectory;
  833.       2:  Copy_A_File;
  834.       3:  View_Directory;
  835.       4:  Delete_A_File;
  836.       5:  Find_Free_Space_On_Drive;
  837.       6:  Log_Drive_Change;
  838.       7:  View_A_File;
  839.       ELSE;
  840.    END (* Case *);
  841.  
  842. END   (* PibFileManipulation *);